home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / RALC.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  15.7 KB  |  688 lines
  1. /*
  2.  * File: ralc.r
  3.  *  Contents: allocation routines
  4.  */
  5.  
  6. extern word alcnum;
  7.  
  8. word coexp_ser = 2;    /* serial numbers for co-expressions; &main is 1 */
  9. word list_ser = 1;    /* serial numbers for lists */
  10. word set_ser = 1;    /* serial numbers for sets */
  11. word table_ser = 1;    /* serial numbers for tables */
  12.  
  13. /*
  14.  * Note: function calls beginning with "MM" are just empty macros
  15.  * unless MemMon is defined.
  16.  */
  17.  
  18. /*
  19.  * AlcBlk - allocate a block.
  20.  */
  21. #begdef AlcBlk(var, struct_nm, t_code, nbytes)
  22. #ifdef MultiRegion
  23. {
  24.    struct region *rp = NULL;
  25. #endif                    /* MultiRegion */
  26.    /*
  27.     * See if there is enough room in the block region.
  28.     */
  29.    if (DiffPtrs(blkend,blkfree) < nbytes) {
  30. #ifdef MultiRegion
  31.       /*
  32.        * See if there is enough room in *any* block region
  33.        */
  34.       for (rp = curblock->next; rp; rp = rp->next) {
  35.      if (DiffPtrs(rp->end,rp->free) >= nbytes) {
  36.         var = (struct struct_nm *)rp->free;
  37.         rp->free += nbytes;
  38.         var->title = t_code;
  39.         break;
  40.         }
  41.          }
  42.       if (!rp) {
  43.          for (rp = curblock->prev; rp; rp = rp->prev) {
  44.         if (DiffPtrs(rp->end,rp->free) >= nbytes) {
  45.            var = (struct struct_nm *)rp->free;
  46.            rp->free += nbytes;
  47.            var->title = t_code;
  48.            break;
  49.            }
  50.             }
  51.          }
  52.       if (!rp)
  53. #endif                    /* MultiRegion */
  54.       if (!collect(Blocks,nbytes))
  55.           return NULL;
  56.       }
  57.    /*
  58.     * If monitoring, show the allocation.
  59.     */
  60.    MMAlc((word)nbytes,t_code);
  61.  
  62.    /*
  63.     * Decrement the free space in the block region by the number of bytes
  64.     *  allocated and return the address of the first byte of the allocated
  65.     *  block.
  66.     */
  67.    blktotal += nbytes;
  68. #ifdef MultiRegion
  69.    if (!rp) {
  70. #endif                    /* MultiRegion */
  71.    var = (struct struct_nm *)blkfree;
  72.    blkfree += nbytes;
  73.    var->title = t_code;
  74. #ifdef MultiRegion
  75.    }
  76. }
  77. #endif                    /* MultiRegion */
  78. #enddef
  79.  
  80. /*
  81.  * AlcFixBlk - allocate a fixed length block.
  82.  */
  83. #define AlcFixBlk(var, struct_nm, t_code)\
  84.    AlcBlk(var, struct_nm, t_code, sizeof(struct struct_nm))
  85.  
  86. /*
  87.  * AlcVarBlk - allocate a variable-length block.
  88.  */
  89. #begdef AlcVarBlk(var, struct_nm, t_code, n_desc)
  90.    {
  91.    register uword size;
  92.  
  93.    /*
  94.     * Variable size blocks are declared with one descriptor, thus
  95.     *  we need add in only n_desc - 1 descriptors.
  96.     */
  97.    size = sizeof(struct struct_nm) + (n_desc - 1) * sizeof(struct descrip);
  98.    AlcBlk(var, struct_nm, t_code, size)
  99.    var->blksize = size;
  100.    }
  101. #enddef
  102.  
  103. /*
  104.  * alcactiv - allocate a co-expression activation block.
  105.  */
  106.  
  107. struct astkblk *alcactiv()
  108.    {
  109.    struct astkblk *abp;
  110.  
  111.    abp = (struct astkblk *)malloc((msize)sizeof(struct astkblk));
  112.  
  113. #ifdef FixedRegions
  114.    /*
  115.     * If malloc failed, attempt to free some co-expression blocks and retry.
  116.     */
  117.    if (abp == NULL) {
  118.       collect(Static,0);
  119.       abp = (struct astkblk *)malloc((msize)sizeof(struct astkblk));
  120.       }
  121. #endif                                  /* FixedRegions */
  122.  
  123.    if (abp == NULL)
  124.       ReturnErrNum(305, NULL);
  125.    abp->nactivators = 0;
  126.    abp->astk_nxt = NULL;
  127.    return abp;
  128.    }
  129.  
  130. #ifdef LargeInts
  131. /*
  132.  * alcbignum - allocate an n-digit bignum in the block region
  133.  */
  134.  
  135. struct b_bignum *alcbignum(n)
  136. word n;
  137.    {
  138.    register struct b_bignum *blk;
  139.    register uword size;
  140.  
  141.    size = sizeof(struct b_bignum) + ((n - 1) * sizeof(DIGIT));
  142.    /* ensure whole number of words allocated */
  143.    size = (size + WordSize - 1) & -WordSize;
  144.    AlcBlk(blk, b_bignum, T_Lrgint, size);
  145.    blk->blksize = size;
  146.    blk->msd = blk->sign = 0;
  147.    blk->lsd = n - 1;
  148.    return blk;
  149.    }
  150. #endif                    /* LargeInts */
  151.  
  152. /*
  153.  * alccoexp - allocate a co-expression stack block.
  154.  */
  155.  
  156. #if COMPILER
  157. struct b_coexpr *alccoexp()
  158.    {
  159.    struct b_coexpr *ep;
  160.    static int serial = 2; /* main coexpression is allocated elsewhere */
  161.  
  162. #ifdef ATTM32
  163.    ep = (struct b_coexpr *)coexp_salloc(); /* 3B2/15/4000 stack */
  164. #else                                   /* ATTM32 */
  165.    ep = (struct b_coexpr *)malloc((msize)stksize);
  166. #endif                                  /* ATTM32 */
  167.  
  168. #ifdef FixedRegions
  169.    /*
  170.     * If malloc failed or if there have been too many co-expression allocations
  171.     * since a collection, attempt to free some co-expression blocks and retry.
  172.     */
  173.  
  174.    if (ep == NULL || alcnum > AlcMax) {
  175.  
  176.       collect(Static,0);
  177.  
  178. #ifdef ATTM32           /* not needed, but here to play it safe */
  179.       ep = (struct b_coexpr *)coexp_salloc(); /* 3B2/15/4000 stack */
  180. #else                                   /* ATTM32 */
  181.       ep = (struct b_coexpr *)malloc((msize)stksize);
  182. #endif                                  /* ATTM32 */
  183.  
  184.       }
  185. #endif                                  /* FixedRegions */
  186.  
  187.    if (ep == NULL)
  188.       ReturnErrNum(305, NULL);
  189.  
  190. #ifdef FixedRegions
  191.    alcnum++;                    /* increment allocation count since last g.c. */
  192. #endif                                  /* FixedRegions */
  193.  
  194.    ep->title = T_Coexpr;
  195.    ep->size = 0;
  196.    ep->id = serial++;
  197.    ep->nextstk = stklist;
  198.    ep->es_tend = NULL;
  199.    ep->file_name = "";
  200.    ep->line_num = 0;
  201.    ep->freshblk = nulldesc;
  202.    stklist = ep;
  203.    MMStat((char *)ep, stksize, 'X');
  204.    return ep;
  205.    }
  206. #else                    /* COMPILER */
  207. struct b_coexpr *alccoexp()
  208.  
  209.    {
  210.    struct b_coexpr *ep;
  211.  
  212.  
  213. #ifdef ATTM32
  214.    ep = (struct b_coexpr *)coexp_salloc(); /* 3B2/15/4000 stack */
  215. #else                                   /* ATTM32 */
  216.    ep = (struct b_coexpr *)malloc((msize)stksize);
  217. #endif                                  /* ATTM32 */
  218.  
  219.    /*
  220.     * If malloc failed or if there have been too many co-expression allocations
  221.     * since a collection, attempt to free some co-expression blocks and retry.
  222.     */
  223.  
  224. #ifdef FixedRegions
  225.    if (ep == NULL || alcnum > AlcMax) {
  226. #else                                   /* FixedRegions */
  227.    if (ep == NULL) {
  228. #endif                                  /* Fixed Regions */
  229.  
  230.       collect(Static, 0);
  231.  
  232.  
  233. #ifdef ATTM32
  234.      ep = (struct b_coexpr *)coexp_salloc(); /* 3B2/15/4000 stack */
  235. #else                                   /* ATTM32 */
  236.          ep = (struct b_coexpr *)malloc((msize)stksize);
  237. #endif                                  /* ATTM32 */
  238.       }
  239.       if (ep == NULL) 
  240.          ReturnErrNum(305, NULL);
  241.  
  242. #ifdef FixedRegions
  243.    alcnum++;        /* increment allocation count since last g.c. */
  244. #endif                                  /* FixedRegions */
  245.  
  246.    ep->title = T_Coexpr;
  247.    ep->es_actstk = NULL;
  248.    ep->size = 0;
  249.    ep->id = coexp_ser++;
  250.    ep->nextstk = stklist;
  251.    ep->es_tend = NULL;
  252.  
  253.  
  254.    stklist = ep;
  255.    MMStat((char *)ep, stksize, E_Coexpr);
  256.    return ep;
  257.    }
  258. #endif                    /* COMPILER */
  259.  
  260. /*
  261.  * alccset - allocate a cset in the block region.
  262.  */
  263.  
  264. struct b_cset *alccset()
  265.    {
  266.    register struct b_cset *blk;
  267.    register int i;
  268.  
  269.    AlcFixBlk(blk, b_cset, T_Cset)
  270.    blk->size = -1;              /* flag size as not yet computed */
  271.  
  272.    /*
  273.     * Zero the bit array.
  274.     */
  275.    for (i = 0; i < CsetSize; i++)
  276.      blk->bits[i] = 0;
  277.    return blk;
  278.    }
  279.  
  280. /*
  281.  * alcfile - allocate a file block in the block region.
  282.  */
  283.  
  284. struct b_file *alcfile(fd, status, name)
  285. FILE *fd;
  286. int status;
  287. dptr name;
  288.    {
  289.    tended struct descrip tname = *name;
  290.    register struct b_file *blk;
  291.  
  292.    AlcFixBlk(blk, b_file, T_File)
  293.    blk->fd = fd;
  294.    blk->status = status;
  295.    blk->fname = tname;
  296.    return blk;
  297.    }
  298.  
  299. /*
  300.  * alchash - allocate a hashed structure (set or table header) in the block
  301.  *  region.
  302.  */
  303. union block *alchash(tcode)
  304. int tcode;
  305.    {
  306.    register int i;
  307.    register struct b_set *ps;
  308.    register struct b_table *pt;
  309.    word serial;
  310.  
  311.    if (tcode == T_Table) {
  312.       serial = table_ser++;
  313.       AlcFixBlk(pt, b_table, T_Table);
  314.       ps = (struct b_set *)pt;
  315.       }
  316.    else {    /* tcode == T_Set */
  317.       serial = set_ser++;
  318.       AlcFixBlk(ps, b_set, T_Set);
  319.       }
  320.    ps->size = 0;
  321.    ps->id = serial;
  322.    ps->mask = 0;
  323.    for (i = 0; i < HSegs; i++)
  324.       ps->hdir[i] = NULL;
  325.    return (union block *)ps;
  326.    }
  327.  
  328. /*
  329.  * alcsegment - allocate a slot block in the block region.
  330.  */
  331.  
  332. struct b_slots *alcsegment(nslots)
  333. word nslots;
  334.    {
  335.    uword size;
  336.    register struct b_slots *blk;
  337.  
  338.    size = sizeof(struct b_slots) + WordSize * (nslots - HSlots);
  339.    AlcBlk(blk, b_slots, T_Slots, size);
  340.    blk->blksize = size;
  341.    while (--nslots >= 0)
  342.       blk->hslots[nslots] = NULL;
  343.    return blk;
  344.    }
  345.  
  346. /*
  347.  * alclist - allocate a list header block in the block region.
  348.  *
  349.  *  Forces a g.c. if there's not enough room for the whole list.
  350.  */
  351.  
  352. struct b_list *alclist(size)
  353. uword size;
  354.    {
  355.    register struct b_list *blk;
  356.  
  357.    if (!blkreserve((word)(sizeof(struct b_list) + sizeof (struct b_lelem)
  358.       + (size - 1) * sizeof(struct descrip)))) return NULL;
  359.    AlcFixBlk(blk, b_list, T_List)
  360.    blk->size = size;
  361.    blk->id = list_ser++;
  362.    blk->listhead = NULL;
  363.    blk->listtail = NULL;
  364.    return blk;
  365.    }
  366.  
  367. /*
  368.  * alclstb - allocate a list element block in the block region.
  369.  */
  370.  
  371. struct b_lelem *alclstb(nslots, first, nused)
  372. uword nslots, first, nused;
  373.    {
  374.    register struct b_lelem *blk;
  375.    register word i, size;
  376.  
  377.    AlcVarBlk(blk, b_lelem, T_Lelem, nslots)
  378.    blk->nslots = nslots;
  379.    blk->first = first;
  380.    blk->nused = nused;
  381.    blk->listprev = NULL;
  382.    blk->listnext = NULL;
  383.    /*
  384.     * Set all elements to &null.
  385.     */
  386.    for (i = 0; i < nslots; i++)
  387.       blk->lslots[i] = nulldesc;
  388.    return blk;
  389.    }
  390.  
  391. /*
  392.  * alcreal - allocate a real value in the block region.
  393.  */
  394.  
  395. struct b_real *alcreal(val)
  396. double val;
  397.    {
  398.    register struct b_real *blk;
  399.  
  400.    AlcFixBlk(blk, b_real, T_Real)
  401.  
  402. #ifdef Double
  403. /* access real values one word at a time */
  404.    { int *rp, *rq;
  405.      rp = (word *) &(blk->realval);
  406.      rq = (word *) &val;
  407.      *rp++ = *rq++;
  408.      *rp   = *rq;
  409.    }
  410. #else                                   /* Double */
  411.    blk->realval = val;
  412. #endif                                  /* Double */
  413.  
  414.    return blk;
  415.    }
  416.  
  417. /*
  418.  * alcrecd - allocate record with nflds fields in the block region.
  419.  */
  420.  
  421. struct b_record *alcrecd(nflds, recptr)
  422. int nflds;
  423. union block *recptr;
  424.    {
  425.    tended union block *trecptr = recptr;
  426.    register struct b_record *blk;
  427.    register int i;
  428.  
  429.    AlcVarBlk(blk, b_record, T_Record, nflds)
  430.    blk->recdesc = trecptr;
  431.    blk->id = (((struct b_proc *)recptr)->recid)++;
  432.    return blk;
  433.    }
  434.  
  435. /*
  436.  * alcrefresh - allocate a co-expression refresh block.
  437.  */
  438.  
  439. #if COMPILER
  440. struct b_refresh *alcrefresh(na, nl, nt, wrk_sz)
  441. int na;
  442. int nl;
  443. int nt;
  444. int wrk_sz;
  445.    {
  446.    struct b_refresh *blk;
  447.  
  448.    AlcVarBlk(blk, b_refresh, T_Refresh, na + nl)
  449.    blk->nlocals = nl;
  450.    blk->nargs = na;
  451.    blk->ntemps = nt;
  452.    blk->wrk_size = wrk_sz;
  453.    return blk;
  454.    }
  455. #else                    /* COMPILER */
  456. struct b_refresh *alcrefresh(entryx, na, nl)
  457. word *entryx;
  458. int na, nl;
  459.    {
  460.    int size;
  461.    struct b_refresh *blk;
  462.  
  463.    AlcVarBlk(blk, b_refresh, T_Refresh, na + nl);
  464.    blk->ep = entryx;
  465.    blk->numlocals = nl;
  466.    return blk;
  467.    }
  468. #endif                    /* COMPILER */
  469.  
  470. /*
  471.  * alcselem - allocate a set element block.
  472.  */
  473.  
  474. struct b_selem *alcselem(mbr,hn)
  475. uword hn;
  476. dptr mbr;
  477.  
  478.    {
  479.    tended struct descrip tmbr = *mbr;
  480.    register struct b_selem *blk;
  481.  
  482.    AlcFixBlk(blk, b_selem, T_Selem)
  483.    blk->clink = NULL;
  484.    blk->setmem = tmbr;
  485.    blk->hashnum = hn;
  486.    return blk;
  487.    }
  488.  
  489. /*
  490.  * alcstr - allocate a string in the string space.
  491.  */
  492.  
  493. char *alcstr(s, slen)
  494. register char *s;
  495. register word slen;
  496.    {
  497.    tended struct descrip ts;
  498.    register char *d;
  499.    register uword fspace;
  500.    char *ofree;
  501. #ifdef MultiRegion
  502.    struct region *rp = NULL;
  503. #endif                    /* MultiRegion */
  504.  
  505.    /*
  506.     * See if there is enough room in the string space.
  507.     */
  508.    fspace = DiffPtrs(strend,strfree);
  509.    if (fspace < slen) {
  510. #ifdef MultiRegion
  511.       /*
  512.        * See if there is enough room in *any* string space.
  513.        */
  514.       for (rp = curstring->next; rp; rp = rp->next) {
  515.      if (DiffPtrs(rp->end,rp->free) >= slen) {
  516.         ofree = d = (char *)rp->free;
  517.         rp->free += slen;
  518.         break;
  519.       }
  520.        }
  521.       if (!rp) {
  522.      for (rp = curstring->prev; rp; rp = rp->prev) {
  523.         if (DiffPtrs(rp->end,rp->free) >= slen) {
  524.            ofree = d = (char *)rp->free;
  525.            rp->free += slen;
  526.            break;
  527.            }
  528.         }
  529.          }
  530.       if (!rp) {
  531. #endif                    /* MultiRegion */
  532.          StrLen(ts) = slen;
  533.          StrLoc(ts) = s;
  534.          if (!collect(Strings,slen))
  535.             return NULL;
  536.          s = StrLoc(ts);
  537. #ifdef MultiRegion
  538.          }
  539. #endif                    /* MultiRegion */
  540.       }
  541.  
  542.    /*
  543.     * If monitoring, note the allocation.
  544.     */
  545.    MMStr(slen);
  546.    strtotal += slen;
  547.  
  548.    /*
  549.     * Copy the string into the string space, saving a pointer to its
  550.     *  beginning.  Note that s may be null, in which case the space
  551.     *  is still to be allocated but nothing is to be copied into it.
  552.     */
  553. #ifdef MultiRegion
  554.    if (!rp)
  555. #endif                    /* MultiRegion */
  556.       ofree = d = strfree;
  557.    if (s) {
  558.       while (slen-- > 0)
  559.          *d++ = *s++;
  560.       }
  561.  
  562.    else
  563.       d += slen;
  564. #ifdef MultiRegion
  565.    if (!rp)
  566. #endif                    /* MultiRegion */
  567.       strfree = d;
  568.    return ofree;
  569.    }
  570.  
  571. /*
  572.  * alcsubs - allocate a substring trapped variable in the block region.
  573.  */
  574.  
  575. struct b_tvsubs *alcsubs(len, pos, var)
  576. word len, pos;
  577. dptr var;
  578.    {
  579.    tended struct descrip tvar = *var;
  580.    register struct b_tvsubs *blk;
  581.  
  582.    AlcFixBlk(blk, b_tvsubs, T_Tvsubs)
  583.    blk->sslen = len;
  584.    blk->sspos = pos;
  585.    blk->ssvar = tvar;
  586.    return blk;
  587.    }
  588.  
  589. /*
  590.  * alctelem - allocate a table element block in the block region.
  591.  */
  592.  
  593. struct b_telem *alctelem()
  594.    {
  595.    register struct b_telem *blk;
  596.  
  597.    AlcFixBlk(blk, b_telem, T_Telem)
  598.    blk->hashnum = 0;
  599.    blk->clink = NULL;
  600.    blk->tref = nulldesc;
  601.    blk->tval = nulldesc;
  602.    return blk;
  603.    }
  604.  
  605. /*
  606.  * alctvtbl - allocate a table element trapped variable block in the block
  607.  *  region.
  608.  */
  609.  
  610. struct b_tvtbl *alctvtbl(tbl, ref, hashnum)
  611. register dptr tbl, ref;
  612. uword hashnum;
  613.    {
  614.    tended struct descrip ttbl = *tbl;
  615.    tended struct descrip tref = *ref;
  616.    register struct b_tvtbl *blk;
  617.  
  618.    AlcFixBlk(blk, b_tvtbl, T_Tvtbl)
  619.    blk->hashnum = hashnum;
  620.    blk->clink = BlkLoc(ttbl);
  621.    blk->tref = tref;
  622.    blk->tval = nulldesc;
  623.    return blk;
  624.    }
  625.  
  626. /*
  627.  * blkreserve - ensure that n bytes are available in the block region.
  628.  */
  629. char *blkreserve (nbytes)
  630. word nbytes;
  631. {
  632.    if (DiffPtrs(blkend,blkfree) < nbytes)
  633.       if (!collect(Blocks,nbytes))
  634.      return NULL;
  635.    return blkfree;
  636. }
  637.  
  638. /*
  639.  * deallocate - return a block to the heap.
  640.  *
  641.  *  The block must be the one that is at the very end of the block region.
  642.  */
  643. novalue deallocate (bp)
  644. union block *bp;
  645. {
  646.    word nbytes;
  647.  
  648.    nbytes = BlkSize(bp);
  649.    if ((char *)bp + nbytes != blkfree) {
  650. #ifdef MultiRegion
  651.       /*
  652.        * The block must be at the very end of *any* block region.
  653.        */
  654.       struct region *rp;
  655.       for(rp = curblock->next; rp; rp = rp->next)
  656.          if ((char *)bp + nbytes == rp->free) {
  657.             rp->free = (char *)bp;
  658.         blktotal -= nbytes;
  659.         MMAlc(-nbytes, 0);
  660.             return;
  661.             }
  662.       for(rp = curblock->prev; rp; rp = rp->prev)
  663.          if ((char *)bp + nbytes == rp->free) {
  664.             rp->free = (char *)bp;
  665.         blktotal -= nbytes;
  666.         MMAlc(-nbytes, 0);
  667.             return;
  668.             }
  669. #endif                    /* MultiRegion */
  670.       syserr ("deallocation botch");
  671.       }
  672.    blkfree = (char *)bp;
  673.    blktotal -= nbytes;
  674.    MMAlc(-nbytes, 0);
  675. }
  676.  
  677. /*
  678.  * strreserve - ensure that n bytes are available in the string region.
  679.  */
  680. char *strreserve (nbytes)
  681. word nbytes;
  682. {
  683.    if (DiffPtrs(strend,strfree) < nbytes)
  684.       if (!collect(Strings,nbytes))
  685.      return NULL;
  686.    return strfree;
  687. }
  688.